Dashboard

Column

map

Row

Rrs for MSI

IOPs

View grid display

---
title: "lighthouse"
output: 
  flexdashboard::flex_dashboard:
    theme: united
    #social: menu
    css: style2.css
    source_code: embed
    orientation: columns
    vertical_layout: fill

---

```{r setup, include=FALSE}
library(flexdashboard)
library(broom)
library(DBI)
library(DT)
library(extrafont)
library(dplyr)
library(stringr)
library(lubridate)
library(leaflet)
library(leafgl)
library(crosstalk)
library(stargazer)
library(wesanderson)
library(plotly)
library(tidymodels)

knitr::opts_knit$set(root.dir = "~/R/lighthouse/R/")
knitr::opts_chunk$set(echo = F, cache = F, message = F, warning = F)
```

```{r load data,}
load("/mnt/D/Documents/Maitrise/Paper/Models/Data/models_db.RData")

wide_db <- models_db %>% select(!c("data")) %>% unnest(cols = c(OLI,S2A), names_sep="_") %>%
	relocate(ID,PID,Station,Mission,DateTime,Lat,Lon,Depth)

wide_db <- wide_db %>% rename_with(~str_replace(.,"S2A","MSI"), starts_with("S2A"))


long_sensor <- wide_db %>% pivot_longer(cols = all_of(str_subset(names(wide_db),
										"OLI|MSI")),
							  names_to = c("Sensor",".value"),
							  names_pattern = "(.+)_(.+)$")

long_sensorBand <- long_sensor %>% pivot_longer(cols = all_of(str_subset(names(long_sensor),
										"B[:digit:]")),
							  names_to = "Band",
							  values_to = "Rrs",
							  values_drop_na = T
							  )

Sensor_nest <- long_sensor %>% group_by(Sensor) %>% nest()
```

```{r interpolation of IOP to common wl 394-700 nm}
IOP_long <- wide_db %>% pivot_longer(cols = all_of(str_subset(names(wide_db),
										"A_|Ap_|Aph_|Ag_|Anap_|Bbp_|Bb_")),
							  names_to = c(".value","Lambda"),
							  names_pattern = "(.+)_(.+)",
							  values_drop_na = T
							  )


IOP_nest <- IOP_long %>% arrange(ID,Lambda) %>%
	group_by(ID) %>% nest()

possibleApprox <- possibly(approx, otherwise=NULL)

ApproxIOP <- IOP_nest %>%
	mutate(
		A = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$A,.x$Lambda, na.rm = T))),
		Ap = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$Ap,.x$Lambda, na.rm = T))),
		Aph = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$Aph,.x$Lambda, na.rm = T))),
		Anap = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$Anap,.x$Lambda, na.rm = T))),
		Ag = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$Ag,.x$Lambda, na.rm = T))),
		Bbp = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$Bbp,.x$Lambda, na.rm = T))),
		Bb = purrr::map(.x = data, ~ data.frame(possibleApprox(.x$Lambda,.x$Bb,.x$Lambda, na.rm = T))),
		  ) %>%
	select(ID,A,Ap,Aph,Anap,Ag,Bbp,Bb)

ApproxIOP <- ApproxIOP %>% dplyr::filter(purrr::map_lgl(A, ~ !is_empty(.)),
							 purrr::map_lgl(Ap, ~ !is_empty(.)),
							 purrr::map_lgl(Aph, ~ !is_empty(.)),
							 purrr::map_lgl(Anap, ~ !is_empty(.)),
							 purrr::map_lgl(Ag, ~ !is_empty(.)),
							 purrr::map_lgl(Bbp, ~ !is_empty(.)),
							 purrr::map_lgl(Bb, ~ !is_empty(.)))

ApproxIOP <- ApproxIOP %>% unnest(cols = c(A, Ap, Aph, Anap, Ag, Bbp, Bb), names_sep="_") %>% na.omit()

ApproxIOP <- ApproxIOP %>% select(A_x,!contains("x")) %>% mutate(
	Lambda = as.numeric(A_x),
	A = A_y,
	Ap = Ap_y,
	Aph = Aph_y,
	Anap = Anap_y,
	Ag = Ag_y,
	Bbp = Bbp_y,
	Bb = Bb_y
) %>% select(!contains(c("y","x")))

# Rrs at 9 wl give 255 731 row ... rather slow but working
# IOPgate <- long_sensorBand %>% filter(Sensor=="MSI") %>%
# 	select(matches("ID|ROI|Sensor|Band|Rrs|SPM|Ag_440")) %>%
# 	right_join(ApproxIOP, by="ID") %>%
# 	na.omit() %>% ungroup()


IOPgate <- wide_db %>%
	select(matches("ID|ROI|SPM|Ag_440")) %>%
	right_join(ApproxIOP, by="ID") %>%
	na.omit() %>% ungroup()

IOPgate <-IOPgate %>%  group_by(ID)

# ggplotly(IOPgate %>% ggplot(aes(x=Lambda, group=ID)) +
# 	geom_line(aes(y=Ag , color="Ag")) + geom_line(aes(y=Bbp, color="Bbp")) +
# 	geom_line(aes(y=Aph, color="Aph")) + geom_line(aes(y=Aph, color="Aph")) +
# 	geom_line(aes(y=Ap, color="Ap")) + geom_line(aes(y=Anap, color="Anap"))+
# 	geom_line(aes(y=A, color="A")) +
# 	theme(text=element_text(family="Times New Roman", face="bold", size=12)) +
# 	ylab("m-1"))
```

```{r sharedata objects}
sd_IOPs <- SharedData$new(IOPgate, key = ~ID, group = "IOPs")

subrrs <- long_sensorBand %>% filter(Sensor=="MSI") %>% select(matches("ID|Sensor|Band|Rrs|SPM"))
sd_rrs <- SharedData$new(subrrs, key = ~ID, group = "IOPs")

submap <- wide_db #%>% select(matches("ID|PID|Station|Mission|DateTime|Lat|Lon|Depth|SPM"))
sd_map <- SharedData$new(submap, group = "IOPs")

```


Dashboard
============

Column {.sidebar}
-----------------------------------------------------------------------
### filters
```{r}
filter_checkbox(id = "mission", 
              label = "Mission", 
              sharedData = sd_map,
		    group = ~Mission,
		    inline = T
		    )

filter_select(id = "ID", 
              label = "ID", 
              sharedData = sd_map,
		    group = ~ID
		    )

filter_select(id = "Station", 
              label = "Station", 
              sharedData = sd_map,
		    group = ~Station
		    )

filter_slider(id = "Depth", 
              label = "Station Depth", 
              sharedData = sd_map,
		    column = ~Depth
		    )

filter_slider(id = "SPM", 
              label = "SPM concentration", 
              sharedData = sd_map,
		    column = ~SPM
		    )

filter_slider(id = "Ag_440", 
              label = "CDOM concentration", 
              sharedData = sd_map,
		    column = ~Ag_440
		    )
```

Column {data-width=550}
-------------------------------------

### map

```{r map}
map <- leaflet(sd_map) %>%
	addScaleBar("bottomright") %>%
	addProviderTiles(provider = providers$CartoDB.Positron, group = 'Positron') %>%
	addProviderTiles("Esri.WorldImagery", group = 'Aerial') %>%
	addProviderTiles("OpenTopoMap", group = 'Terrain') %>%
	addCircleMarkers(group = "Stations",
				  radius = 0.5,
				  color = "red",
				  popup = ~paste0('
Station Details

',
                                   'ID: ', ID, '
',
				  			'PID: ', PID, '
',
				  			'Station: ', Station, '
',
				  			'DateTime: ', DateTime, '
',
				  			'SPM: ', SPM, ' [mg.l-1]
',
				  			'Depth: ', Depth, ' [m-1]
')
				  ) %>%
  addLayersControl(
        baseGroups = c("Positron", "Aerial", "Terrain"),
        overlayGroups = 'Stations',
        options = layersControlOptions(collapsed = TRUE)
      )

map

#bscols(widths = c(2, NA) ,Qfilter ,map)

# Cannot filter and cluster at the same time for now : https://github.com/rstudio/leaflet/issues/478
# clusterOptions = markerClusterOptions(disableClusteringAtZoom = 10)
```

Row {.tabset}
-------------------------------------


### Rrs for MSI

```{r}
prrs <- sd_rrs %>% plot_ly(x = ~Band, y = ~Rrs, text=~ID, colors=~ID) %>% add_lines()
prrs
```

### IOPs

```{r}
IOPs <- sd_IOPs %>%
	plot_ly(x = ~Lambda, text=~ID) %>%
	add_lines(y = ~A , color="A") %>%
	add_lines(y = ~Ap , color="Ap") %>%
	add_lines(y = ~Aph , color="Aph") %>%
	add_lines(y = ~Anap , color="Anap") %>%
	add_lines(y = ~Ag , color="Ag") %>%
	add_lines(y = ~Bb , color="Bb") %>%
	add_lines(y = ~Bbp , color="Bbp")
IOPs
```

###  View grid display


```{r}
datatable(sd_map,
  extensions = c("Buttons", "ColReorder"),
  escape = TRUE, rownames = FALSE,
  class = "cell-border stripe",
  options = list(
    dom = "Bfrtip", buttons = c("csv"), deferRender = TRUE,
    scrollY = 50,
    pageLength = 15,
    scroller = TRUE,
    colReorder = TRUE
  )
)
```